home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / TPUG Xtras / Xtras / club1.d64 / disk lab.msort (.txt) < prev    next >
Commodore BASIC  |  2009-02-07  |  5KB  |  134 lines
  1. 0 CLR:X$="XX":FORI=.TO3:X$=X$+X$:NEXT
  2. 2 X$=X$+"XXXXXXX":GOTO12
  3. 4 > DISK LAB.MSORT V1.1 <
  4. 5 > BY FRED LAYBERGER   <
  5. 6 > OMAHA,NE - OCT 1985 <
  6. 8 POKE808,225:A1=PEEK(55):A2=PEEK(56):POKE55,PEEK(51):POKE56,PEEK(52):RETURN
  7. 10 Z=FRE(.):POKE55,A1:POKE56,A2:POKE808,237:RETURN
  8. 12 RESTORE:POKE53280,13:POKE53281,15:P$="[147]WORKING...[151]":PRINTP$
  9. 14 SD=8:DD=8:SR=0:DR=0:SA=4
  10. 16 IFPEEK(1015)<>.THENSD=PEEK(1015):DD=PEEK(1016):SR=PEEK(1017):DR=PEEK(1018):SA=PEEK(1019)
  11. 18 DL=830:IFPEEK(DL)=160THEN24
  12. 20 OPEN1,DD,.,MID$(STR$(DR),2,1)+":DISK LAB.DIR,S,R":FORI=DLTODL+148
  13. 22 INPUT#1,A:POKEI,A:NEXT:CLOSE1
  14. 24 CLOSE15:OPEN15,DD,15:GOSUB524
  15. 26 DIMV$(152):IFPEEK(49152)<>32THENLOAD"DISK LAB.SORT",DD,1:GOSUB524
  16. 28 OPEN1,DD,.,MID$(STR$(DR),2,1)+":\\MASTER*,S,R":GOSUB524
  17. 30 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:NF=VAL(BK$):ND=N
  18. 32 D$=ID$:ID$="\\"
  19. 34 V$(.)=DT$+ID$+RIGHT$("    "+BK$,4):DIMT$(NF+1)
  20. 36 POKE850,76:POKE851,88:POKE852,3:POKE952,21
  21. 38 GOSUB8:FORI=1TON:SYSDL:V$(I)=LEFT$(X$,16)
  22. 40 PRINT""V$(I):NEXT:GOSUB10:CLOSE1
  23. 42 NF=1:IFP=2THENU=1:I=N+1:V$(I)=" \MSORTED*      ":GOTO48
  24. 44 GOTO150
  25. 46 FORI=1TOND:PRINTP$TAB(20)"DIRECTORY"I"[157] OF"ND
  26. 48 PRINT""V$(I)"[151]"TAB(20)"PROGRAM MAY PAUSE[151]"
  27. 50 CLOSE1:OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+V$(I)+",S,R":GOSUB524:IFP>1THENI=25
  28. 52 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:GOSUB8
  29. 54 IFLEFT$(DT$,7)="\MASTER"THENID$="\\"
  30. 56 FORJ=1TON:SYSDL:IFP>1THENT$(NF)=LEFT$(X$,19):GOTO60
  31. 58 T$(NF)=LEFT$(X$,16)+RIGHT$("   "+STR$(I),3)
  32. 60 PRINT""LEFT$(T$(NF),16)TAB(20)"ITEM"NF"[157] OF "RIGHT$(V$(.),4)
  33. 62 IFP>1THENIFJ=ITHENGOSUB10:GOSUB8:I=I+25
  34. 64 NF=NF+1:IFNF>1200ORNF>VAL(RIGHT$(V$(.),4))+1THENJ=N:I=ND:B$="GREATER THEN ":GOSUB516
  35. 66 NEXT:GOSUB10:IFP>1THENCLOSE1:N=NF-1:GOTO104
  36. 68 NEXT:CLOSE1:N=NF-1:PRINTP$:Z=FRE(.)
  37. 69 IFNF<VAL(RIGHT$(V$(.),4))THENB$="LESS THEN ":GOSUB516
  38. 100 PRINT"[147]  SORTING..."N"PROGRAMS"
  39. 102 SYS 49152,N,T$(1):P=2:POKE1015,SD:POKE1016,DD:POKE1017,SR:POKE1018,DR:POKE1019,SA
  40. 104 DT$=LEFT$(V$(.),16):ID$=MID$(V$(.),17,2):BK$=MID$(V$(.),19)
  41. 150 REM ** MAIN MENU
  42. 152 PRINT"[147]DONE -CHOOSE ONE"
  43. 153 PRINT""NF-1"RECORDS ALPHABETIZED[151]"
  44. 154 IFP<2THENPRINT" 1[146] ALPHABETIZE MASTER":IFNF=1THEN162
  45. 156 PRINT" 2[146] PRINT TO SCREEN"
  46. 158 PRINT" 3[146] PRINT TO PRINTER"
  47. 160 IFU<>1THENPRINT" 4[146] SAVE SORTED FILE"
  48. 162 PRINT" 5[146] RETURN TO DISK LABELER+"
  49. 164 PRINT" 6[146] QUIT"
  50. 166 GETA$:IFP<2THENIFA$="1"THEN46
  51. 168 IFNF=1THENIFP<2THEN176
  52. 170 IFA$="2"THENGOSUB502:GOTO150
  53. 172 IFA$="3"THENGOSUB402:GOTO150
  54. 174 IFU<>1THENIFA$="4"THENGOSUB302:GOTO150
  55. 176 IFA$="5"THEN202
  56. 178 IFA$<>"6"THEN166
  57. 180 END
  58. 200 REM ** RETURN TO LABELER
  59. 202 POKE1020,1:PRINT"[147]LOAD "CHR$(34)"DISK LABELER+*"CHR$(34)CHR$(44)DD
  60. 204 PRINT"RUN":POKE198,8:FORI=1TO7:POKE630+I,13:NEXT:PRINT"[151]":NEW
  61. 300 REM *** SAVE
  62. 302 PRINTP$:PRINT#15,"S"+MID$(STR$(DR),2,1)+":?\M*":F$=" \MSORTED       "
  63. 304 ID$=D$
  64. 306 OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+F$+",S,W":PRINT""F$"[151]"
  65. 308 PRINT#1,N:PRINT#1,DT$:PRINT#1,ID$:PRINT#1,BK$:PRINT#1,P:GOSUB8
  66. 310 FORI=1TON
  67. 312 IFU=1THENT$=V$(I)+"    ":GOTO316
  68. 314 T$=LEFT$(T$(I),16)+LEFT$(RIGHT$(T$(I),3)+"    ",4)
  69. 316 PRINT#1,T$:PRINT""LEFT$(T$,16);
  70. 318 PRINT" ITEM"I"[157] OF"N:NEXT:GOSUB10
  71. 320 CLOSE1:GOSUB524:IFU=1THENN=NF-1:ID$="\\":RETURN
  72. 322 F$="\\MASTER        ":N=ND
  73. 324 U=1:PRINTP$:GOTO306
  74. 400 REM ** PRINT TO PRINTER
  75. 402 PRINT"[147]  PREPARE PRINTER AND ALIGN PAPER [151]":GOSUB518:IFA$="^"THENRETURN
  76. 404 PRINT"  *** WORKING[151] *** DO NOT DISTRUB[146][151] ***"
  77. 406 E$=CHR$(27):S=4:CLOSES:OPENS,S,SA
  78. 408 DEFFNR(X)=INT((IP/CL-INT(IP/CL))*CL+.5):C1$=CHR$(15):C2$=CHR$(18):Z=.:IP=N
  79. 410 H1$=E$+"G"+E$+"E":H2$=E$+"H"+E$+"F"
  80. 412 A=2:E=17:B=8:C=1:D=1:CL=3:PL=56
  81. 414 T1$=C1$+E$+"G":T2$=C2$+E$+"H":PG=PL
  82. 416 P1$="":P9$="-----------------------------------"
  83. 418 PRINT#S,E$"U"CHR$(48);:FORI=1TOCL-1:PRINT#S,P1$SPC(B/A);:NEXT:PRINT#S,P1$
  84. 420 PRINT#S,H1$;:FORI=1TOC:PRINT#S:NEXT
  85. 422 PRINT#S:PRINT#S,SPC(E)CHR$(14)DT$ID$CHR$(20)
  86. 424 PRINT#S,SPC(E)NF-1" BLOCKS FREE - "D$;:PRINT#S,H2$;
  87. 426 X=INT(IP/CL):IFN>PG*CLTHENX=PL:IP=PG*CL
  88. 428 C3=2*X:C4=3*X:C5=4*X:R=FNR(X):IFR>.THENIFR<=CLTHENX=X+1
  89. 430 C3=2*X:C4=3*X:C5=4*X
  90. 432 ONRGOTO436,438:REM **CL=3
  91. 434 GOTO440
  92. 436 C3=X:C4=2*X-1:GOTO440
  93. 438 C4=3*X-1:GOTO440
  94. 440 PRINT#S,T1$
  95. 442 FORI=1TOD:PRINT#S:NEXT:FORI=1TOCL-1:PRINT#S,P9$SPC(B);:NEXT:PRINT#S,P9$
  96. 444 IFZ>.THENC3=C3+Z:C4=C4+Z:C5=C5+Z:IFN<=PG*CLTHENIP=IP+Z
  97. 446 F=16:FORI=1TOX:GETA$:IFA$="^"THENI=X:GOTO500
  98. 448 PRINT#S,LEFT$(T$(I+Z),F)SPC(B-5);
  99. 450 K=VAL(RIGHT$(T$(I+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  100. 452 IFC3=>I+X+ZTHENPRINT#S,LEFT$(T$(I+X+Z),F)SPC(B-5);
  101. 454 IFC3=>I+X+ZTHENK=VAL(RIGHT$(T$(I+X+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  102. 456 IFI+C3>IPTHENPRINT#S:GOTO476
  103. 458 IFC4=>I+C3THENPRINT#S,LEFT$(T$(I+C3),F)SPC(B-5);
  104. 460 IFC4=>I+C3THENK=VAL(RIGHT$(T$(I+C3),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  105. 462 IFI+C4>IPTHENPRINT#S:GOTO476
  106. 464 IFC5=>I+C4THENPRINT#S,LEFT$(T$(I+C4),F)SPC(B-5);
  107. 466 IFC5=>I+C4THENK=VAL(RIGHT$(T$(I+C4),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  108. 468 IFI+C5>IPTHENPRINT#S:GOTO476
  109. 470 IFC5+X=>I+C5THENPRINT#S,LEFT$(T$(I+C5),F);
  110. 472 IFC5+X=>I+C5THENK=VAL(RIGHT$(T$(I+C5),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  111. 474 PRINT#S
  112. 476 NEXT:IFX<PLTHENFORI=1TOINT(PL-X):PRINT#S:NEXT:IFXAND1THENPRINT#S
  113. 478 FORI=1TOCL:PRINT#S,P9$;SPC(B);:NEXT:PRINT#S:PRINT#S
  114. 480 IFN<=PG*CLTHEN500
  115. 482 PRINT#S,T2$:PRINT#S,H1$:FORI=1TOC:PRINT#S:NEXT
  116. 484 PRINT#S,CHR$(14)DT$ID$CHR$(20)" CONTINUED...":PRINT#S,"PAGE#"(PG/PL)+1" - "D$H2$
  117. 486 Z=PG*CL:IP=N-(PG*CL):PG=PG+PL:GOTO426
  118. 500 PRINT#S,T2$;:CLOSES:RETURN
  119. 502 REM *** PRINT TO SCREEN
  120. 504 PRINT"[147]  FILENAME"TAB(23)"DISKNAME[151]"
  121. 506 FORI=1TON
  122. 508 PRINTTAB(2)LEFT$(T$(I),16)TAB(23);
  123. 510 K=VAL(RIGHT$(T$(I),3)):PRINTLEFT$(V$(K),16)
  124. 512 IFPEEK(214)=23THENGOSUB518:PRINT"[147]":IFA$="^"THENI=N:NEXT:RETURN
  125. 514 NEXT:GOTO518
  126. 516 PRINT"[147]# OF AVAILABLE RECORDS IS"
  127. 517 PRINT""B$"MASTER COUNT OF"RIGHT$(V$(.),4)""
  128. 518 PRINT" PRESS A KEY TO CONTINUE - '^'TO RETURN[146][151]"
  129. 520 GETA$:IFA$=""THEN520
  130. 522 RETURN
  131. 524 INPUT#15,ER,ER$,T,S
  132. 526 IFERTHENPRINT" "ER;ER$;T;S:GOSUB518:END
  133. 528 RETURN
  134.